home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ftpser1a / findfold.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-08-24  |  3.6 KB  |  135 lines
  1. VERSION 5.00
  2. Begin VB.Form FindFolder 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "FindFolder"
  5.    ClientHeight    =   5070
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   3600
  9.    LinkTopic       =   "FindFile"
  10.    MaxButton       =   0   'False
  11.    MinButton       =   0   'False
  12.    ScaleHeight     =   5070
  13.    ScaleWidth      =   3600
  14.    StartUpPosition =   1  'CenterOwner
  15.    Begin VB.CommandButton FldrDone 
  16.       Caption         =   "Done"
  17.       Height          =   375
  18.       Left            =   960
  19.       TabIndex        =   2
  20.       Top             =   4600
  21.       Width           =   1575
  22.    End
  23.    Begin VB.TextBox DirPath 
  24.       Height          =   285
  25.       Left            =   120
  26.       TabIndex        =   1
  27.       Top             =   120
  28.       Width           =   3375
  29.    End
  30.    Begin VB.ListBox FolderList 
  31.       BeginProperty Font 
  32.          Name            =   "Terminal"
  33.          Size            =   9
  34.          Charset         =   255
  35.          Weight          =   400
  36.          Underline       =   0   'False
  37.          Italic          =   0   'False
  38.          Strikethrough   =   0   'False
  39.       EndProperty
  40.       Height          =   4020
  41.       ItemData        =   "FindFolder.frx":0000
  42.       Left            =   120
  43.       List            =   "FindFolder.frx":0002
  44.       Sorted          =   -1  'True
  45.       TabIndex        =   0
  46.       Top             =   480
  47.       Width           =   3375
  48.    End
  49. Attribute VB_Name = "FindFolder"
  50. Attribute VB_GlobalNameSpace = False
  51. Attribute VB_Creatable = False
  52. Attribute VB_PredeclaredId = True
  53. Attribute VB_Exposed = False
  54. Option Explicit
  55. Dim DrvS(32) As String
  56. Dim LastStr As String
  57. Dim DrvC As Integer
  58. Private Sub FldrDone_Click()
  59.   Form_Terminate
  60. End Sub
  61. Private Sub FolderList_Click()
  62. Dim s As String, t As String, s2 As String
  63. Dim i As Integer
  64.   i = FolderList.ListIndex + 1
  65.   s2 = FolderList.Text
  66.   If Mid(s2, 1, 1) = "[" Then
  67.     s2 = Mid(s2, 2, 2) & "\"
  68.     DirPath = s2
  69.   Else
  70.     If FolderList.Text = ".." Then
  71.       s = Left(LastStr, Len(LastStr) - 1)
  72.       Do Until Right(s, 1) = "\"
  73.         s = Left(s, Len(s) - 1)
  74.       Loop
  75.       s2 = s
  76.       DirPath = s2
  77.     Else
  78.       s2 = DirPath & FolderList.Text & "\"
  79.       DirPath = s2
  80.     End If
  81.   End If
  82.   LastStr = s2
  83.   FolderList.Clear
  84.   'Debug.Print i; s2
  85.   s = FindFile("*.*", s2)
  86.   Add_Drives
  87. End Sub
  88. Private Sub Form_Load()
  89. Dim s As String
  90.   GetSystemDrives 'load the system drives
  91.   If AddEditDir.Tag <> "" Then
  92.     LastStr = AddEditDir.Tag
  93.     DirPath = LastStr
  94.     s = FindFile("*.*", AddEditDir.Tag)
  95.   End If
  96.   Add_Drives
  97. End Sub
  98. Private Sub Add_Drives()
  99. Dim x As Integer
  100.   For x = 1 To DrvC
  101.     FolderList.AddItem "[" & DrvS(x) & "]"
  102.   Next
  103. End Sub
  104. Private Sub Form_Terminate()
  105.   AddEditDir.Tag = DirPath.Text
  106.   Unload Me
  107. End Sub
  108. Private Sub GetSystemDrives()
  109. Dim rtn As Long
  110. Dim d As Integer
  111. Dim AllDrives As String
  112. Dim CurrDrive As String
  113. Dim tmp As String
  114.   tmp = Space(64)
  115.   rtn = GetLogicalDriveStrings(64, tmp)
  116.   AllDrives = Trim(tmp)               'get the list of all available drives
  117.   d = 0
  118.   Do Until AllDrives = Chr$(0)
  119.     d = d + 1
  120.     CurrDrive = StripNulls(AllDrives) 'strip off one drive item from the allDrives
  121.     CurrDrive = Left(CurrDrive, 2)    'we can't have the trailing slash, so ..
  122.     DrvS(d) = CurrDrive
  123.     DrvC = d
  124.   Loop
  125. End Sub
  126. Private Function StripNulls(startstr) As String
  127. Dim pos As Integer
  128.   pos = InStr(startstr, Chr$(0))
  129.   If pos Then
  130.     StripNulls = Mid(startstr, 1, pos - 1)
  131.     startstr = Mid(startstr, pos + 1, Len(startstr))
  132.     Exit Function
  133.   End If
  134. End Function
  135.